﻿#!perl
#c:\Perl\bin\perl.exe
# written by Pavel C <pavelch+dcbot@gmail.com>
# src site: https://code.google.com/p/dc-bot/
use strict;
#use warnings;
use integer;
my $nothreads=1;

#use if !$nothreads,"threads";
#use if !$nothreads,"Thread::Queue";

#use uft8;
#use CGI;
use HTTP::Daemon;
use HTTP::Status;

use Encode;
use JSON;
use Getopt::Std;    # http://search.cpan.org/search?module=Getopt::Std
#use encoding 'cp1251';
use encoding 'utf8';

my $dump=undef;
my $sconsole='cp866';#'utf8';#'cp866';
my $sInCodepage='utf8';
#'cp1251';#'utf8';
my $sOutCodepage='utf8'; #'cp1251';
my $slang='ru';
my $nport=33733;
my $saddress=undef;
my $shelper="texts/helper.utf8.txt";

my $sHttpCharset; #'windows-1251';
if($sOutCodepage eq 'cp1251'){
  $sHttpCharset='windows-1251'
}else{
  $sHttpCharset='utf-8'
}

my $allowed_ips='^(192\.168\.|127\.)';

my $nMaxChatLines=5; #need to get from $info
my $nMaxListeners=10;

$Getopt::Std::STANDARD_HELP_VERSION = 1;  # Use standard-conforming behavior
$main::VERSION=0.1;
sub main::HELP_MESSAGE {
    print << 'EndHelp';

Usage: aibot_serv.pl [OPTION]
    -f ip       allowed ip filter (default:^(192\.168\.|127\.))
    -a host     host address (not using)[not properly working]
    -p port     port (default:33733)
    -d          enable dump messges & answers (default:off)
    -c codepage console codepage (default:cp866)
    -i codepage incoming message codepage (default:cp1251)
    -o codepage outcoming message & files codepage (default:cp1251) [other cp not properly working]
    -l language language (default:ru)
    -t file     helper filename
EndHelp
}

sub main::VERSION_MESSAGE {
    print "aibot_serv.pl version $main::VERSION\n";
    if ($nothreads){
       print "no threads, shared objects\n";
    }else{
       print "with threads, shared objects\n";
    }
}



my %opts = ();
getopts('df:a:p:c:i:o:l:t:', \%opts);
$dump=1 if defined $opts{d};
$allowed_ips=$opts{f} if defined $opts{f};
$sconsole=$opts{c} if defined $opts{c};
$sInCodepage=$opts{i}    if defined $opts{i};
$sOutCodepage=$opts{o}  if defined $opts{o};
$slang=$opts{l}    if defined $opts{l};
$nport=$opts{p}    if defined $opts{p};
$saddress=$opts{a} if defined $opts{a};
$shelper=$opts{t} if defined $opts{t};
#my $log=1;
#use if $dump,"Data::Dumper";
if ($dump){
  require Data::Dumper;
}
sub Dumper
{
  return Data::Dumper::Dumper(shift) if $dump;
#  return "not using Data::Dumper\n";
}

#print STDERR Dumper("test Dumper");
binmode STDERR, ":utf8" if $sOutCodepage eq 'utf8';
sub myrand
{
  my ($r)=@_;
  return time()%$r;
}
#test("T","t");
#test("П","п");
#test2();
#sub mylc
#{
#  my $ttt=lc(shift);  
#  $ttt=~ tr/А-Я/а-я/;
#  return $ttt;
#}
#sub test
#{
#  my ($s1,$s2)=@_;
#  warn "case-insensitive compare test failed $s1!=$s2" if $s1!~/$s2/i;
#  warn "case-insensitive compare test failed lc($s1) ne lc($s2)" if lc($s1) ne lc($s2);
#  warn "case-insensitive compare test failed mylc($s1) ne mylc($s2)" if mylc($s1) ne mylc($s2);
#}
#sub test2
#{
#  my $octets = 'тест';
#  warn 'string has UTF-8 flag' if !Encode::is_utf8($octets);
#  print "not " if Encode::is_utf8($octets);
#  print "ok - \$octets has no UTF-8 flag\n";
#
#  #my $string = Encode::decode('cp1251', $octets);
#  # Encode::_utf8_off($string);
#  #print "not " unless Encode::is_utf8($string);
#  #print "ok - \$string has UTF-8 flag\n";
#}


#print Dumper(@ARGV);
main();
###########################################################
# no thread needs
###########################################################
# aibot_func
###########################################################
sub aibot_worker_func
{
  my ($last_text,$info,$db)=@_;
  my %answer=(msg=>'', 'time'=>$last_text->{time});
  if(!defined $last_text or $last_text eq ''){      
    return \%answer;
  }
  my $s=$last_text->{content};
  $s=~s/\r\\n/ /g;
  my %h=();  
  eval{
    %h=%{from_json($s)};          
  };
  if ($@){
    warn $@;    
    return \%answer;
  }
  if(!defined $h{data} or $h{data} eq ''){    
    return \%answer;
  }    
  my $x=find_replica($h{user},$h{data},$info,$db); 
  $x='' if !defined $x;    
  %answer=(msg=>$x, q=>$h{data},'time'=>$last_text->{time}+myrand($info->{t_diff})+$info->{t1}); #." ".int(rand(100))
  #if( $log>0 and $x ne '')
  #if(open (FOUT,">>:utf8","answered.log")){
  #
  #  close(FOUT);
  #}
  return \%answer;  
}
###########################################################
# tSys_Tags
###########################################################
sub tSys_Tags
{  
  my ($tUser,$s,$sData)=@_;
  #print STDERR Dumper($tUser);
  #print STDERR "s= ".Dumper($s);
    if (defined $sData and $sData ne '' ){
      $s=~s/\[MSG\]/$sData/g; 
    }
    $s=~s/\[NICK\]/$tUser->{NI}/g;
    $s=~s/\[DESC\]/$tUser->{DE}/g;
    $s=~s/\[EMAIL\]/$tUser->{EM}/g;
    $s=~s/\[IP\]/$tUser->{I4}/g;
    $s=~s/\[SHORTSHARE\]/$tUser->{SSshort}/g;
    $s=~s/\[SHARE\]/$tUser->{SS}/g;
    $s=~s/\[TAG\]/$tUser->{TA}/g;
    $s=~s/\[HUBNAME\]/$tUser->{HL}/g;
#--    $s=~s/\[CID\]/$tUser->{CID}/;
    return $s;
}
###########################################################
# load_helper
###########################################################
sub load_helper
{
  open(FIN,"<:utf8",$shelper);
  #open(FIN,"<:encoding(cp1251)","texts/helper.cp1251.txt");
  #open(FIN,"<texts/helper.cp1251.txt");

  my @file=<FIN>;
  close(FIN);
  my %hash1=();
  my $mode=undef;
  my $num=undef;
  for(my $i=0;$i<=$#file;$i++){
    my $line=$file[$i];
    chomp $line;
    if( $line =~ m/^\s*((--)|([\`\'\"\#])|(\/\/))/ ){
      next;
    }
    if($line=~m/^\s*\}/){
      $mode=undef;
      $num=undef;
      next;
    }
    #u=user
    #a=answer
    #q=question
    #f=function
    #t=tag
    if($line=~m/^\s*([qaftu])(\w+)\s*=\s*\{/){
      $mode=$1;
      $num=$2;
      if(!defined $hash1{$num}){        
        $hash1{$num}={q=>[],a=>[]};
      }
      next;
    }
    if(defined $mode and defined $num){
      #print STDERR Dumper(%hash);
      if ($mode eq 'u'){
        $hash1{$num}->{$mode}->{$line}=1;
      }
      else
      {
        push @{$hash1{$num}->{$mode}},$line;
      }
    }
  }
  #print STDERR Dumper(sort keys %hash1);
  #print STDERR $hash1{1}->{a}->[0]."=y\n";
  return \%hash1;
}
###########################################################
# find_replica
###########################################################
sub find_replica
{
  my ($tUser,$sData,$my_info,$db)=@_;
  my $x=$sData;
  #$x=~s/^$my_info->{nick}: (.*)$/$1/;
  if($x=~m/(https?:\/\/)|(ftp:\/\/)|(magnet:)/){
    return '';
  }
  my $answer='';
  #print STDERR $he->{1}->{a}->[0]."=y\n";    
  if ($sInCodepage ne $sOutCodepage){
    eval{
      Encode::from_to($x, $sInCodepage, $sOutCodepage);#if $sInCodepage ne $sOutCodepage
    };
    warn $@ if $@;
    return $answer if $@;
  }
  #$x=mylc($x);
  my %hAnswer=();
  my $he=$db->{helper};
  LOOP:foreach my $n (sort keys %{$he}){
    foreach my $q (@{$he->{$n}->{q}}){
      #%hAnswer=();
      next if defined $he->{$n}->{u} and !defined $he->{$n}->{u}->{$tUser->{NI}};
      $q=~s/\[MYNICK\]/$my_info->{nick}/g;
      if($x=~m/$q/i){
        
        #my ($k1, $k2, $k3) = ($1, $2, $3);
        #if (defined $1){
        $hAnswer{1}=$1;# if defined $1;
        $hAnswer{2}=$2;# if defined $2;
        $hAnswer{3}=$3;# if defined $3;
        #}
        #print STDERR "$k1,$k2,$k3";  
        #  print STDERR Dumper(%hAnswer);

        my $v=$#{$he->{$n}->{a}};
        if ($v>0){
          $v=int(myrand($v+1));
        }
        $answer=@{$he->{$n}->{a}}[$v];
        if(defined $hAnswer{1}){
          $answer=~s/\[1\]/$hAnswer{1}/g;
          $answer=~s/\[2\]/$hAnswer{2}/g;# if defined $hAnswer{2};
          $answer=~s/\[3\]/$hAnswer{3}/g;# if defined $hAnswer{3};
        }
        last LOOP;
      }
      #last if $answer ne '';
    }
  }
  
  #print STDERR $answer."=a $x=x\n";
  if ($answer ne ''){
    if ($sInCodepage ne $sOutCodepage){
      foreach my $k (keys %{$tUser}){
        eval{
          Encode::from_to($tUser->{$k}, $sInCodepage, $sOutCodepage);# if $sInCodepage ne $sOutCodepage;
        };
        warn $@ if $@;
      }
    }
    $answer = tSys_Tags($tUser,$answer);
  }
  if(defined $dump){
    my $t="x=$x a=$answer";
    eval{      
      Encode::_utf8_off($t) if $sOutCodepage eq 'utf8';
      Encode::from_to($t, $sOutCodepage,$sconsole) if $sconsole ne $sOutCodepage;
      print STDERR "$t\n";
    };
    warn $@ if $@;
  }
  #Encode::from_to($answer, "utf8", "cp1251");        
  #Encode::from_to($nick, "utf8", "cp1251");  
  return $answer;
}
###########################################################
# get_my_info
###########################################################
sub get_my_info
{
  my $minfo=shift;
  return ('no info',undef) if !defined $minfo or $minfo eq '';
  my $info;
  eval{
   $info=from_json($minfo);  
  };
  warn $@ if $@;
  return ($@,undef) if $@;
  my ($t1,$t2)=0;  
  $t1=@{$info->{hub}->{tDelay}}[0];
  $t2=@{$info->{hub}->{tDelay}}[1];
  eval{
    Encode::from_to($info->{nick}, $sInCodepage, $sOutCodepage) if $sInCodepage ne $sOutCodepage;
  };
  warn $@ if $@;
  return ($@,undef) if $@;
  my $t_diff=abs($t2-$t1);
  if($t_diff<1){$t_diff=1;}
  if($t1<1){$t1=1;}
  $info->{t_diff}=$t_diff;
  $info->{t1}=$t1;
  #print STDERR Dumper($db);
  print STDERR "info= ".Dumper($info) if defined $dump;
  return ('',$info);
}
###########################################################
# create_no_threads
###########################################################
sub create_no_threads
{
  my ($h_threads,$rcontent,$db)=@_;
  if(scalar keys %$h_threads>=$nMaxListeners){ # 0..9
     my @a=sort keys %$h_threads;
     delete $h_threads->{$a[0]};
#    return undef;
  }
  
  my ($e,$info)=get_my_info($rcontent);
  if ($e){
    warn $e;
    return undef;
  }

  my $msg = MY->new();
  my $answer = MY->new();
  my $refresh;
  $refresh=0;
    
  my $id=$db->{init_id}++;
  my %h=(thr=>sprintf('(%#x)',  $id),id=>$id,msg=>$msg,answer=>$answer,refresh=>\$refresh,info=>$info);
 
  return \%h;
}
sub MY::new {
  my $this = shift;
  my $class = ref($this) || $this;
  my @array;
  my $self = {};
  $self->{ARRAY}=\@array;
  bless $self, $class;  
  return $self;
}
sub MY::enqueue
{
  my $self = shift;
  my $value = shift;
  unshift(@{$self->{ARRAY}},$value);
  #print STDERR "push ".Dumper($value);
}
sub MY::dequeue_nb
{
  my $self = shift;
  #return undef if $#{$self->{ARRAY}}<0;  
  return pop @{$self->{ARRAY}};    
}
sub MY::dequeue
{
  my $self = shift;
  #return undef if $#{$self->{ARRAY}}<0;  
  return pop @{$self->{ARRAY}};    
}
sub MY::peek
{
  my $self = shift;
  return undef if $#{$self->{ARRAY}}<0;
  my $x=${$self->{ARRAY}}[$#{$self->{ARRAY}}];  
  return $x;
}

sub reload_db_no_threads
{
  my ($db,$cached_time)=@_;  
  $db->{helper}=load_helper();
  $db->{refresh_time}=$cached_time+10;  
}

sub create_cookie
{
  my $hthread=shift;
  my $sthr="".$hthread->{thr}; 
  $sthr=~s/^threads=SCALAR//; 
  return 'STHRID='.$sthr.';THRID='.$hthread->{id};
}
sub parse_cookie
{
  my $cookie=shift;
  #CGI->new($r->header('cookie'))->Vars;
  my %qp=();
  $cookie=~m/STHRID=([\da-fA-FxX\(\)]+);THRID=(\d+)/;
  $qp{STHRID}=$1;
  $qp{THRID}=$2;
  return \%qp;  
}
sub check_cookie_no_threads
{
  my ($sthr1,$thr2)=@_;    
  my $sthr2="$thr2";
  $sthr2=~s/^threads=SCALAR//;
  #print STDERR "$sthr $sthr2\n";
  if($sthr1 ne $sthr2){
    #$c->send_error(RC_FORBIDDEN);
    #next;
    return RC_FORBIDDEN;
  }  
  return 0;#fail#503 Service Unavailable 410 gone
}

sub aibot_func_no_threads
{  
  my ($msg, $ans,$info,$db)=@_;  
  my $last_text;  
  
  while(defined ($last_text=$msg->dequeue())){    
    last if $last_text=~m/^exit$/;       
    my $answer = aibot_worker_func($last_text,$info,$db);   
    $ans->enqueue($answer);    
  }  
}

sub main
{
  #my @array :shared;

  my $d = HTTP::Daemon->new(
    LocalAddr=>$saddress,
    LocalPort=>$nport
  )
  || die "Could not create http daemon: $!n";

  
  open(FIN, ">/tmp/aibot.pid") || die "Could not create pid file: $!n";
  print FIN $d->url,"\n";
  my $rand1=int(myrand(1000)+10000);
  print FIN $rand1,"\n";
  close(FIN);
  print "Please contact me at: URL: ", $d->url, "\n";#$rand1\n";
  if ($nothreads){
    print "no threads, shared objects\n";
  }else{
    print "with threads, shared objects\n";
  }
  my %h_threads=();
  my ($reload_db, $create_listener,$check_cookie); #functions
  my $db;
  if($nothreads){
    $create_listener=\&create_no_threads;
    $reload_db=\&reload_db_no_threads;
    $check_cookie=\&check_cookie_no_threads;
    my %hdb=();
    $db=\%hdb;
  }else{
    $create_listener=\&create_with_threads;
    $reload_db=\&reload_db_with_threads;
    $check_cookie=\&check_cookie_with_threads;
    my %hdb:shared;
    $db=\%hdb;
  }
  my $time1=time();
  $reload_db->($db,$time1);
  $db->{init_id}=$rand1;
  $db->{stat_time}=$time1+5;
  my $exit =0;
  while (!$exit and (my $c = $d->accept) ) {
    my $ip=$c->peerhost();
    if ($ip!~m/$allowed_ips/){
      $c->send_error(RC_FORBIDDEN);
      next;
    }
    while (my $r = $c->get_request) {
      #print $c->sockhost(), "\n";
      #print $c->peerhost(), "\n";
      
      if (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/connect" or $r->uri->path eq "/c")) {
          if (!defined $r->content or $r->content eq ''){
            $c->send_error(405); #405 Method Not Allowed 
            next;        
          }
          
          my $hthread=$create_listener->(\%h_threads,$r->content,$db);
          if(!defined $hthread){
            $c->send_error(503);
            next;
          }
          $h_threads{$hthread->{id}}=$hthread;
 
          my $cookie=create_cookie($hthread);

          my $res = HTTP::Response->new(200);
          $res->header('Content-Type' => 'text/plain;charset='.$sHttpCharset,
                       'Content-Language' => $slang,
                       'Set-Cookie' => $cookie
           );
          $res->content('{"connected": 1, "cookie": "'.$cookie.'"}');

          $c->send_response($res);
          next;
      }elsif (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/s" or $r->uri->path eq "/stat")){
          my $cached_time=time();
          if($db->{stat_time}>=$cached_time){
            $c->send_error(503);
            next;
          }          
          my $res = HTTP::Response->new(200);
          $res->header(
              'Content-Type' => 'text/html;charset='.$sHttpCharset,
              'Content-Language' => $slang
            );
            my $stat='<html><body><pre>';
            foreach my $k (keys %h_threads){
              $stat.="ID=$k | ".$h_threads{$k}->{thr}.' | '.$h_threads{$k}->{info}->{hubname}.' | '.$h_threads{$k}->{info}->{cookie}."\r\n";
            }
            $stat.='</pre></body></html>';
            $res->content($stat);
            $c->send_response($res);          
            $db->{stat_time}=$cached_time+10;
          next;
      }elsif (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/r" or $r->uri->path eq "/refresh")){
          my $cached_time=time();
          if($db->{refresh_time}>=$cached_time){
            $c->send_error(503);
            next;
          }
          print STDERR "refresh helper\n" if $dump;
          $reload_db->($db,$cached_time);          

          my $res = HTTP::Response->new(204);          
          $c->send_response($res);
          
          foreach my $t (values %h_threads){
            #print STDERR Dumper($t);
            if(${$t->{refresh}}==0)
            {
              lock($t->{refresh});
              ${$t->{refresh}}=1;
            }
          }      
          next;
      }elsif (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/quit" or $r->uri->path eq "/exit")){
        print STDERR "threads=".(scalar keys %h_threads)."\n" if $dump;

        #if((scalar keys %h_threads)<=0){
          my $res = HTTP::Response->new(204);
          $c->send_response($res);
          $exit=1;
          last;
        #}else{
        #  $c->send_error(RC_FORBIDDEN);
        #}        
      }elsif (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/flash" or $r->uri->path eq "/clean")){
        print STDERR "threads=".(scalar keys %h_threads)."\n" if $dump;

        #if((scalar keys %h_threads)<=0){
          my $res = HTTP::Response->new(204);
          $c->send_response($res);
          #$exit=1;
          #last;
        foreach my $k (keys %h_threads){
          my %h1=%{$h_threads{$k}};
          $h1{msg}->enqueue("exit");
        }
        %h_threads=();
        next;
        #}else{
        #  $c->send_error(RC_FORBIDDEN);
        #}        
      }
      #print STDERR Dumper($r->header('cookie'));
      my $cookie=$r->header('cookie');
      if(!defined $cookie or $cookie eq ''){
        $c->send_error(RC_FORBIDDEN);
        next;
      }
      my $query_params = parse_cookie($cookie);

      if(!defined $query_params->{THRID} or !defined $h_threads{$query_params->{THRID}}){
        $c->send_error(RC_FORBIDDEN);
        next;
      }else{
        #print STDERR Dumper($query_params);
        my $err=$check_cookie->($query_params->{STHRID},$h_threads{$query_params->{THRID}}->{thr});
        if($err){
          $c->send_error($err);
          next;
        }
      }
      my %h=%{$h_threads{$query_params->{'THRID'}}};
      

      #print STDERR Dumper(%h);
      if ($r->method eq 'GET' and $r->uri->path eq "/q1"){
          my $res = HTTP::Response->new(200);
    		  $res->header('Content-Type' => 'text/plain;charset='.$sHttpCharset,
                       'Content-Language' => $slang);
    		  $res->content('{"paper": "A4", "count": 4}');
    		  $c->send_response($res);

      }elsif (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/d" or $r->uri->path eq "/disconnect")){
        
          $h{msg}->enqueue("exit");
          my $res = HTTP::Response->new(200);
          $c->send_response($res);
          delete $h_threads{$query_params->{'THRID'}};
          print STDERR Dumper(\%h_threads) if $dump;
      }elsif (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/m" or $r->uri->path eq "/message")){
          #print STDERR Dumper($h{msg});
          my $rcontent=$r->content;
          if (!defined $rcontent or $rcontent eq ''){
            $c->send_error(405); #405 Method Not Allowed 
            next;        
          } 
          my %z=(content=>$rcontent,'time'=>time());
          $h{msg}->enqueue(\%z);
          my $res = HTTP::Response->new(200);
          $c->send_response($res);
          aibot_func_no_threads($h{msg},$h{answer},$h{info},$db) if $nothreads;
    		  #print STDERR Dumper($h{msg});
      }elsif (($r->method eq 'GET' or $r->method eq 'POST') and ($r->uri->path eq "/answer" or $r->uri->path eq "/a"))
      {
          my $sum=undef;
          my $b;
          my $count=0;
          my $cached_time=time();
          my $q='';
          while($count<$nMaxChatLines and defined($b = $h{answer}->peek()) and $b->{time}+1<=$cached_time){
            $b = $h{answer}->dequeue_nb();           
            if(defined $sum){
              if($sum ne '' and $b->{msg} ne ''){
                $sum.="\r\n".$b->{msg};
                $q.="\r\n".$b->{q};
              }elsif($sum eq '' and $b->{msg} ne ''){
                $sum=$b->{msg};
                $q=$b->{q};
              }
            }else{
              $sum=$b->{msg};
              $q=$b->{q};
            }
            $count++;
          }          
          if(!defined $sum){
            
            if ($nothreads){
              if(!defined $h{answer}->peek() and !defined $h{msg}->peek()){
                print STDERR "possible error\n" if $dump;
                send_message($c,'','',1);
              }else{
                my $res = HTTP::Response->new(204);
                $c->send_response($res);  
              }
            }else {
              my $res = HTTP::Response->new(204);
              $c->send_response($res);  
            }
          }else{
            send_message($c,$sum,$q,$count);            
          }
      }else{
          $c->send_error(RC_FORBIDDEN);
      }
    }
    $c->close;
    undef($c);
  }

  unlink(".aibot.pid");
  print STDERR "exiting main...\n";
}
sub send_message
{
  my ($c,$sum,$q,$count)=@_;
  Encode::_utf8_off($sum) if $sOutCodepage eq 'utf8';
  Encode::_utf8_off($q) if $sOutCodepage eq 'utf8';
  my %h=(msg=>$sum,q=>$q,count=>$count);
  my $json = to_json(\%h);

  my $res = HTTP::Response->new(200);
  $res->header(
    'Content-Type' => 'text/plain;charset='.$sHttpCharset,
    'Content-Language' => $slang
  );
  $res->content($json);
  $c->send_response($res);
}
__END__
######################
# with threads
######################
sub reload_db_with_threads
{
  my ($db,$cached_time)=@_;
  {
    lock($db);
    $db->{helper}=threads::shared::shared_clone(load_helper());
    $db->{refresh_time}=$cached_time+10;
  }  
}
sub aibot_func_with_threads
{
  my ($msg, $ans,$info,$sh_db,$refresh)=@_;  
  my $last_text=undef;  
  my $db=undef;
  
  #print STDERR "test threads $info\n";
  while($last_text=$msg->dequeue()){ 
    last if $last_text=~m/^exit$/;    
    if(${$refresh})
    {
      lock($refresh);
      lock($sh_db);
      $db=threads::shared::shared_clone($sh_db);
      ${$refresh}=0;
      print STDERR "refreshed db\n";
    }
    my $answer = aibot_worker_func($last_text,$info,$db);   
    $ans->enqueue($answer);    
  }
  print STDERR "exiting thread...\n";
}
###########################################################
# create_with_threads
###########################################################
sub create_with_threads
{
  my ($h_threads,$rcontent,$db)=@_;
  if(scalar keys %$h_threads>=$nMaxListeners){ # 0..9
    return undef;
  }
  my @threads = threads->list(threads::running);
  if($#threads>=$nMaxListeners){ #current+threads
    #$c->send_error(503);
    #next;
    return undef;
  }

  my ($e,$info)=get_my_info($rcontent);
  if ($e){
    warn $e;
    return undef;
  }


  my $msg = Thread::Queue->new();
  my $answer = Thread::Queue->new();
  my $refresh:shared;
  $refresh=1;
  my $thr = threads->create(\&aibot_func_with_threads, $msg,$answer,$info,$db,\$refresh);
  if(!defined $thr){
    #$c->send_error(503);
    #next;
    return undef;
  }
  my $id=($thr->tid()+1000);
  my %h=(thr=>$thr,id=>$id,msg=>$msg,answer=>$answer,refresh=>\$refresh,info=>$info);
 
  return \%h;
}
sub check_cookie_with_threads
{
  my ($sthr1,$thr2)=@_; 
  my $err=check_cookie_no_threads($sthr1,$thr2);
  return $err if($err);
  my @threads = threads->list(threads::running);  
  foreach my $t (@threads){
    if($t==$thr2){      
      return 0; # ok
    }
  }
  return 503;#fail#503 Service Unavailable 410 gone
}